package clutils;

use warnings;
use clnet qw(CLNET_return_static_ips2 CLNET_map_ip_to_network2);

BEGIN {
	use Carp qw(confess cluck);
	use cld_client;
	use Digest::MD5;
	use Data::Dumper;
	use Sys::Hostname;
	use File::Basename;
	use XML::Simple;
	use clnet qw(CLNET_get_network_list2 CLNET_return_network_static_ip2);
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);

	$VERSION=0.6;
	@ISA	= qw(Exporter);
	@EXPORT	= qw(&logmsg &errmsg &warnmsg &logwarn &validate_cluster_cfg &get_cldaemon_connection2
			&allocate_resource  &deallocate_resource &get_resource_free_count
			&local_drbd_module_check_n_load  &register_exit &debugmsg
			&remote_drbd_module_check_n_load &mapdevicename 
			&is_mounted &get_device_info &get_kernel_mods &get_drbd_dev_status
			&summary_connection_state &summary_sync_state &summary_valid_data
			&_get_static_ip_list
			&is_true &is_false &is_valid &get_node_ssh_ip &get_clnetd_connection2 
			&get_cllockd_connection2 &set_write_ssh_ip_info &match_node_name
			&get_clhbd_connection2 &get_allocated_resource &get_over_mounts
			&get_cldaemon_info &is_valid_node &validate_application_cfg &debug &netlist
			&get_installed_drbdsetup_version &get_drbd_proc_version &ssh_on_node &scp_to_node
			&compat_meta_version &check_net_known_connections &get_digest_methods);
	$exit_handler=undef;
}
our @EXPORT_OK;

my $write_ssh_ip_info=0;

sub set_write_ssh_ip_info {
	$write_ssh_ip_info=$_[0];
}

sub is_true {
	return 1 if (lc($_[0]) eq "true" || lc($_[0]) eq "yes" || $_[0] eq "1");
	return 0;
}

sub is_false {
	return 1 if (lc($_[0]) eq "false" || lc($_[0]) eq "no" || $_[0] eq "0");
	return 0;
}

sub is_valid {
	return is_true($_[0]) || is_false($_[0]);
	return 0;
}

sub logmsg {
	return if ! $::ARG_verbose;
	my @d=localtime(time());
	$s=sprintf("INFO  %02d/%02d/%d",$d[3],$d[4]+1,$d[5]+1900);
	$s.=sprintf(" %02d:%02d:%02d %s\n",$d[2],$d[1],$d[0],$_[0]);
	if(defined($::LOGFD)) {
		print $::LOGFD $s;
	} else {
		print $s;
	}
}

sub debug {
	return if ! defined($::ARG_debug) || ! $::ARG_debug;
	my @d=localtime(time());
	$s=sprintf("DEBUG %02d/%02d/%d",$d[3],$d[4]+1,$d[5]+1900);
	$s.=sprintf(" %02d:%02d:%02d %s\n",$d[2],$d[1],$d[0],$_[0]);
	if(defined($::LOGFD)) {
		print $::LOGFD $s;
	} else {
		print $s;
	}
}

sub debugmsg {
	return debug(@_);
}

sub logwarn {
	my @d=localtime(time());
	$s=sprintf("WARN  %02d/%02d/%d",$d[3],$d[4]+1,$d[5]+1900);
	$s.=sprintf(" %02d:%02d:%02d %s\n",$d[2],$d[1],$d[0],$_[0]);
	if(defined($::LOGFD)) {
		print $::LOGFD $s;
	} else {
		print $s;
	}
}

sub warnmsg {
	logwarn(@_);
}

sub register_exit {
	$exit_handler=$_[0];
}

sub errmsg {
	my @d=localtime(time());
	$s=sprintf("ERROR %02d/%02d/%d",$d[3],$d[4]+1,$d[5]+1900);
	$s.=sprintf(" %02d:%02d:%02d %s\n",$d[2],$d[1],$d[0],$_[0]);
	if(defined($::LOGFD)) {
		print $::LOGFD $s;
	} else {
		print $s;
	}
	if(defined($exit_handler) && defined($_[1])) {
		&$exit_handler;
	}
	exit($_[1]) if defined($_[1]);
}

#########################################################################
# Will return (object) if ok (undef,errcode,errmsg,...) if error	#
#########################################################################

sub validate_cluster_cfg {
my $ARG_config=shift;
my $ARG_mode=shift;
my (@s,$xml,$md5_sum,$sss,$xml_sum);
my ($fd3,$check_sum);

	$ARG_config="/etc/cluster/clconf.xml" if !defined($ARG_config);
	$ARG_mode="secure" if !defined($ARG_mode);
	$ARG_mode="secure" if $ARG_mode eq "0";
	if(! -f $ARG_config) {
		return (undef,1,"Configuraton file $ARG_config does not exist.");
	}
	if($ARG_mode eq "secure") {
		@s=stat(_);
		if($s[2] & 07777 != 0600) {
			return (undef,2,"Config file $ARG_config must be 600 permissions");
		}
		if(! -f "/etc/cluster/.clbuild.md5") {
			return (undef,3,"It does not appear that the cluster has yet been built",
				"Please run the clbuild command first.");
		}
	}
	eval '$xml=XMLin($ARG_config);';
	if($@) {
		if($@ =~ /mismatched tag at line ([0-9]+),/m) {
			return (undef,4,"Invalid setting at line $1 of $ARG_config");
		}
		return (undef,4,"Invalid XML file definition: $@");
	}

	if($ARG_mode eq "secure") {
		$md5_sum=Digest::MD5->new;
		$sss=Dumper($xml);
		$sss =~ s/\s+//mg;
		$sss =~ s/'//mg;
		$md5_sum->add($sss);
		$xml_sum=$md5_sum->hexdigest;

		if(!open($fd3,"</etc/cluster/.clbuild.md5")) {
			return(undef,5,"Unable to open file for reading /etc/cluster/.clbuild.md5: $!");
		} else {
			$check_sum=<$fd3>;
			close($fd3);
			$check_sum="invalid" if !defined($check_sum);
			chomp $check_sum;
		}

		if($xml_sum ne $check_sum) {
			return(undef,6,"The cluster configuration file ",
				"$ARG_config appears to have been changed",
				"but the changes have not yet been validated.",
				"Please run the clbuild(1M) command first before",
				"running this command again.",
				"Please note that if the cluster is already running",
				"you will need to use the --force argument. This will",
				"not affect running applications.");
		}
	}
	#################################################################
	# Validate necessary configuration information is available.	#
	#################################################################
	my @ml=();
	for (qw(version data datadetail key logdir)) {
		if(!exists($xml->{global}->{$_})) {
			push @ml,$_;
		}
	}
	if(exists($xml->{global}->{parallel})) {
		if(is_true($xml->{global}->{parallel})==0 && 
			is_false($xml->{global}->{parallel})==0) {
			return(undef,98,"Global 'parallel' not given recognised value.");
		}
	}
	if(scalar(@ml)) {
		return(undef,98,"Missing following attribues from globals section:",
				join(",",@ml));
	}

	#################################################################
	# Ok the xml has been validated so return the correct info.	#
	#################################################################

	return ($xml);
}

sub _get_static_ip_list($$) {
my ($xml,$node)=@_;
my ($ip,$rc,$cnet,@L);

	@L=();
	my @nets=();
	($rc,@nets)=CLNET_get_network_list2(node=>$node,xml=>$xml);
	if(!$rc) {
		errmsg("Unable to get network topology info - is node valid?",1);
		return undef;
	}

	for $cnet (@nets) {
		$ip=CLNET_return_network_static_ip2(node=>$node,network=>$cnet,xml=>$xml);
		if(!defined($ip)) {
			logwarn("Unable to find static IP address for $node on network $cnet!");
			next;
		}
		push @L,$ip;
	}
	return @L;
}

sub get_DAEMON_connection2($$$;$) {
my $xml=shift;
my $port=shift;
my $tryhost=shift;
my $timeout=shift;
my ($server_port,$server_key);
my (@nodes,$got_server,$conn,$rnode_ip,$resp);

	$timeout=10 if !defined($timeout);
	if(defined($port)) {
		$port="%%CLDAEMON" if $port eq "port";
		$port="%%CLNETD" if $port eq "clnetdport";
		$port="%%CLLOCKD" if $port eq "clport";
		$port="%%CLHBD" if $port eq "clhbdport";
	} else {
		$port="%%CLDAEMON";
	}
	$server_port=get_allocated_resource(hostname,"PORT","__CLUSTER__",$port,undef);
	if($server_port==-1) {
		errmsg("No Server port allocated for port - has clbuild been run?",22);
	}
	$server_key=$xml->{global}->{key};
	my @IPS=_get_static_ip_list($xml,$tryhost);
	my $type='4';
	if(exists($xml->{global}->{iptype})) {
		$type=$xml->{global}->{iptype};
	}
	$conn=cld_client->new(TYPE=>$type,PORT => $server_port,INET => $tryhost, KEY => $server_key,ILIST=>join(",",@IPS));
	if(defined($conn)) {
		$resp=$conn->send_msg(MSG => "PING", TIMEOUT => $timeout);
		if(defined($resp)) {
			$got_server=1;
			$conn->close_session;
		} else {
			$conn=undef;
		}
	}
	return $conn;
}

sub get_cllockd_connection2 {
my $xml=shift; my %args=@_;
my ($node,$timeout);

	$node=hostname;
	$node=$args{node} if exists($args{node});
	$timeout=$args{timeout} if exists($args{timeout});
	return get_DAEMON_connection2($xml,"clport",$node,$timeout);
}

sub get_clhbd_connection2 {
my $xml=shift; my %args=@_;
my ($node,$timeout);

	$node=hostname;
	$node=$args{node} if exists($args{node});
	$timeout=$args{timeout} if exists($args{timeout});
	return get_DAEMON_connection2($xml,"clhbdport",$node,$timeout);
}

sub get_clnetd_connection2 {
my $xml=shift; my %args=@_;
my ($node,$timeout);

	$node=hostname;
	$node=$args{node} if exists($args{node});
	$timeout=$args{timeout} if exists($args{timeout});
	return get_DAEMON_connection2($xml,"clnetdport",$node,$timeout);
}

sub get_cldaemon_connection2 {
my $xml=shift; my %args=@_;
my ($node,$timeout);

	$node=hostname;
	$node=$args{node} if exists($args{node});
	$timeout=$args{timeout} if exists($args{timeout});
	return get_DAEMON_connection2($xml,"port",$node,$timeout);
}

sub get_cldaemon_info {
my $conn=shift;
my $msg=shift;
my $timeout=shift;
my $resp;

	if(!defined($timeout)) {
		$timeout=10;
	}
	$resp=$conn->send_msg(MSG => $msg, TIMEOUT => $timeout);
	$conn->close_session;
	return $resp;
}

sub is_valid_node {
my $nodename=shift;
my $xml=shift;
my @nodes;

	if($nodename eq hostname) {
		return 1;
	}
	if(scalar(grep {/^$nodename$/} (sort(keys(%{$xml->{node}}))))) {
		return 1;
	}
	return 0;
}

#########################################################################
# Takes the specified application and returns the same result type	#
# as the cluster validation code:					#
# 0175: Also optionally takes a nochecksums option (1/0) to ignore	#
#	checksums if user wishes.					#
# Returns a list of with at least three elements in it:			#
# object,errorcode,errmsg[,...]						#
#########################################################################

sub validate_application_cfg {
my $ARG_app=shift;
my $no_checksums=shift;
$no_checksums=0 if !defined($no_checksums);
my ($md5_sum,$dumper,$xml2,$fd3);
my ($sss,$vgbuild_sum,$ARG_app2);

	$ARG_app2="/etc/cluster/$ARG_app/appconf.xml";
	if(! -f $ARG_app2) {
		return (undef,5,"Application configuration file for \"$ARG_app\" does not exist.");
	}
	eval '$xml2=XMLin($ARG_app2);';
	if($@) {
		if($@ =~ /mismatched tag at line ([0-9]+),/m) {
			return (undef,4,"Invalid setting at line $1 of $ARG_app");
		}
		return (undef,4,"Invalid XML file definition: $@");
	}
	$md5_sum=Digest::MD5->new;
	$dumper=Dumper($xml2);
	$dumper =~ s/\s+//mg;

	#################################################################
	# Change the dumper output so we generate a DIFFERENT md5 value	#
	# for this stage - stop users trying to cheat configuration by	#
	# copying md5 files!						#
	# This is changed between releases to ensure a validate is	#
	# performed when a release changes.				#
	#################################################################

	$dumper =~ s/\s+/_/gi;
	$dumper =~ s/a/g/gi;
	$dumper =~ s/0/H/gi;
	$dumper =~ s/=/y/gi;
	$dumper =~ s/'//gi;
	$dumper =~ s/"//gi;
	
	$md5_sum->add($dumper);

	#################################################################
	# Check to see if the build.md5 exists, and it is valid for	#
	# for this file.						#
	#################################################################

	if(! -f "/etc/cluster/$ARG_app/build.md5") {
		return(undef,99,"Missing Volume Group build checksum - please run with --build first!");
	}
	if(!open($fd3,"/etc/cluster/$ARG_app/build.md5")) {
		return(undef,98,"Unable to read /etc/cluster/$ARG_app/build.md5: $!");
	}
	$vgbuild_sum=<$fd3>; chomp $vgbuild_sum;

	$sss=$md5_sum->hexdigest;
	if(!$no_checksums && $vgbuild_sum ne $sss) {
		return(undef,97,
			"The configuration file for $ARG_app has been modified but",
			"the clbuildapp commands has not been rerun to validate the",
			"changes. You can ignore this warning and add a --nochecksums",
			"option to the command if you so wish.");
	}
	close($fd3);
	return($xml2,0,"");
}

#########################################################################
# Return the number for the allocated resource - if allocated.		#
# Args:									#
# [0] - node name							#
# [1] - type (RAID,[E]NBD,DRBD,PORT)					#
# [2] - application							#
# [3] - vg | %%LEMS							#
# [4] - lv | undef							#
# [5] - xml - mandatory for remote node info only, but send anyway!!	#
# Returns:								#
# -1  - specified resource is not allocated.				#
# >=0 - number of the resource allocated.				#
#########################################################################

sub get_allocated_resource {
my $node=shift;
my $type="\U$_[0]";
shift;
my ($application,$vg,$lv,$xml)=@_;
my $remote=0;
my ($d,$e,$e2);
my @entries;
my $fd;
my $newname;
my $num;
my @ee;

	if(substr($vg,0,2) ne "%%") {
		$newname=".$application.$vg.$lv";
	} else {
		$newname=".$application.$vg";
	}
	$remote=1 if $node ne hostname;
	if($type eq "PORT") {
		$d="/etc/cluster/.resources/ports";
	}
	if($type eq "RAID") {
		$d="/etc/cluster/.resources/raid";
	}
	if($type eq "DRBD") {
		$d="/etc/cluster/.resources/drbd";
	}
	if($remote) {
		if(! $xml) {
			cluck("Missing XML argument in details.");
			$e2=`ssh $node -o batchmode=yes "ls $d/*$newname 2>/dev/null"`;
			$e=`ssh $node -o batchmode=yes "ls $d 2>/dev/null"`;
		} else {
			$e2=ssh_on_node(node=>$node,xml=>$xml,cmd=>"ls $d/*$newname 2>/dev/null");
			$e=ssh_on_node(node=>$node,xml=>$xml,cmd=>"ls $d 2>/dev/null");
		}
		chomp $e;
		chomp($e2);
		#########################################################
		# If the resource already exists return that number now	#
		#########################################################

		if($e2 ne "") {
			$e2=basename($e2);
			($num)=($e2 =~ /^([0-9]+)\./);
			return $num;
		}
	} else {
		opendir($fd,$d);
		@entries = sort(grep { /^[0-9]+/ } readdir($fd));
		closedir($fd);

		@ee = grep { /^[0-9]+$newname$/ } @entries;
		if(defined($ee[0])) {
			($num)=($ee[0] =~ /^([0-9]+)\./);
			return $num;
		}
	}
	return -1;
}

#########################################################################
# Given a type of entry and node name (type is RAID, DRBD, NBD or PORT)	#
# it will return the number of the device to				#
# use, and also allocate that device as well, (using the application,	#
# vg, lv which are specied as last three arguments.			#
#									#
# Note: This also checks to see if the said app.vg.lv already has	#
#	a port and if so will return that number.			#
# Args:									#
# [0] - node name							#
# [1] - type (RAID,[E]NBD,DRBD,PORT)					#
# [2] - application							#
# [3] - vg | %%LEMS,%%CLDAEMON,%%CLNETD,%%CLLOCKD,%%CLHBD		#
# [4] - lv | undef							#
# [5] - xml - if remote must be present.
# Returns:								#
# -1 - error when attempting to allocate the resource.			#
# -2 - no more resources of this type available.			#
# >0 - number of the resource allocated.				#
#									#
# For linuxha 1.2 it will allocate based on lowest numeric value,	#
# rather than alphanumeric order.					#
#									#
#########################################################################

sub allocate_resource {
my $node=shift;
my $type="\U$_[0]";
shift;
my ($application,$vg,$lv,$xml)=@_;
my $remote=0;
my ($d,$e,$e2);
my @entries;
my $fd;
my $newname;
my $num;
my @ee;

	if(substr($vg,0,2) ne "%%") {
		$newname=".$application.$vg.$lv";
	} else {
		$newname=".$application.$vg";
	}
	$remote=1 if $node ne hostname;
	if($remote && !$xml) {
		confess("Remote allocation but no xml argument.");
	}
	if($type eq "PORT") {
		$d="/etc/cluster/.resources/ports";
	}
	if($type eq "RAID") {
		$d="/etc/cluster/.resources/raid";
	}
	if($type eq "DRBD") {
		$d="/etc/cluster/.resources/drbd";
	}
	if($remote) {
		$e2=ssh_on_node(node=>$node,xml=>$xml,cmd=>"ls $d/*$newname 2>/dev/null");
		chomp($e2);
		$e=ssh_on_node(node=>$node,xml=>$xml,cmd=>"ls $d 2>/dev/null");
		chomp $e;

		#########################################################
		# If the resource already exists return that number now	#
		#########################################################

		if($e2 ne "") {
			$e2=basename($e2);
			($num)=($e2 =~ /^([0-9]+)\./);
			return $num;
		}
		#########################################################
		# New for linuxha 1.2					#
		#########################################################
		my @e=split(/\s+/,$e);
		@entries=sort {my $c=$a; my $d=$b; $c =~ s/\..*//; $d =~ s/\..*//; int($c) <=> int($d);} @e;
	} else {
		opendir($fd,$d);
		@entries = sort(grep { /^[0-9]+/ } readdir($fd));
		closedir($fd);

		@ee = grep { /^[0-9]+$newname$/ } @entries;
		if(defined($ee[0])) {
			($num)=($ee[0] =~ /^([0-9]+)\./);
			return $num;
		}
		#########################################################
		# New for linuxha 1.2					#
		#########################################################
		@entries=sort {my $c=$a; my $d=$b; $c =~ s/\..*//; $d =~ s/\..*//; int($c) <=> int($d);} @entries;
	}

	#################################################################
	# Now the @entries contains the list of resource, free or	#
	# otherwise, so simply read through one at time until we	#
	# find a free one.						#
	#################################################################

	$num=-1;
	foreach (@entries) {
		next if ! /^[0-9]+\.free/;
		# Ok the current entry is free, so we need to allocate it
		($num)=(/([0-9]+)/);
		$newname="$num$newname";
		last;
	}
	return(-1) if $num==-2;

	if(!$remote) {
		if(!rename("$d/$num.free","$d/$newname")) {
			return -1;
		}
		return $num;
	}

	#################################################################
	# Handle the remote allocation now...				#
	#################################################################

	ssh_on_node(node=>$node,xml=>$xml,cmd=>"mv $d/$num.free $d/$newname");
	if($?>>8) {
		return -1;
	}
	return $num;
}

#########################################################################
# This will return the number of currently available resources on the	#
# specified node , of the specified type. The type will be PORT, RAID or#
# or NBD.								#
#									#
# Arguments:								#
# [0] - nodename							#
# [1] - type (DRBD, [E]NBD, RAID or PORT)				#
# [2] - xml - mandatory if remote node.					#
# Returns:								#
# >=0 Count of resources currently available.				#
#########################################################################

sub get_resource_free_count {
my $node=shift;
my $type="\U$_[0]";
my $xml=$_[1];
my $remote;
my ($d,$e);
my @entries;
my $fd;

	$remote=1 if $node ne hostname;
	if($remote && !$xml) {
		confess("Called for remote with xml argument.");
	}
	if($type eq "PORT") {
		$d="/etc/cluster/.resources/ports";
	}
	if($type eq "RAID") {
		$d="/etc/cluster/.resources/raid";
	}
	if($type eq "DRBD") {
		$d="/etc/cluster/.resources/drbd";
	}
	if($remote) {
		$e=ssh_on_node(node=>$node,xml=>$xml,cmd=>"ls $d/[0-9]*.free 2>/dev/null");
		chomp $e;
		@entries=split(/\s+/,$e);
	} else {
		opendir($fd,$d);
		@entries = grep { /^[0-9]+\.free$/ } readdir($fd);
		closedir($fd);
	}
	if(!defined($entries[0])) {
		return 0;
	}
	return scalar(@entries);
}

#########################################################################
# Given a node, type and the application,vg,lv of the resource to 	#
# remove.								#
#									#
# Args:									#
# [0] - node name							#
# [1] - type (RAID,[E]NBD,DRBD,PORT)					#
# [2] - application							#
# [3] - vg | %%LEMS,%%CLDAEMON,%%CLNETD,%%CLLOCKD,%%CLHBD		#
# [4] - lv | undef							#
#									#
# Returns:								#
# -1 - error when attempting to remove the resource.			#
# 0  - resource did not exist.						#
# >0 - resource number that was removed.				#
#########################################################################

sub deallocate_resource {
my $node=shift;
my $type="\U$_[0]";
shift;
my ($application,$vg,$lv)=@_;
my $remote=0;
my ($d,$e,$e2,$n);
my @entries;
my $fd;
my $removename;
my $num;
my @ee;
	if(substr($vg,0,2) ne "%%") {
		$removename=".$application.$vg.$lv";
	} else {
		$removename=".$application.$vg";
	}
	$remote=1 if $node ne hostname;
	if($type eq "PORT") {
		$d="/etc/cluster/.resources/ports";
	}
	if($type eq "RAID") {
		$d="/etc/cluster/.resources/raid";
	}
	if($type eq "DRBD") {
		$d="/etc/cluster/.resources/drbd";
	}
	if($remote) {
		#################################################################
		# If the remote resource does not exist, then return 0		#
		#################################################################
		$e2=`ssh $node -o batchmode=yes "ls $d/*$removename 2>/dev/null"`;
		chomp $e2;
		if($e2 eq "") {
			return 0;
		}
		#################################################################
		# We now remove the resource file by simply renaming it to 	#
		# indicate it is now free.					#
		#################################################################
		$e=basename($e2);
		($n)=($e =~ /^([0-9]+)\..*/);
		$e2=`ssh $node -o batchmode=yes "mv -f $d/$e $d/$n.free 2>&1"`;
		chomp $e2;
		if(length($e2)) {
			return -1;
		}
		return $n;
	} else {
		opendir($fd,$d);
		@entries = grep { /^[0-9]+/ } readdir($fd);
		closedir($fd);

		@ee = grep { /^[0-9]+$removename$/ } @entries;
		if(defined($ee[0])) {
			($num)=($ee[0] =~ /^([0-9]+)\./);
			if(! rename("$d/$ee[0]","$d/$num.free")) {
				return -1;
			}
			return $num;
		}
	}
	return 0;
}

#########################################################################
# This routine will check to see if the specified mount point is a 	#
# currently mounted file system and will return 1 for yes, 0 for no.	#
# Args:									#
# [0] - mount point to check						#
# [1] - hostname to check on						#
# Returns:								#
# -1 - error (perhaps unable to contact remote host)			#
# 0 - file system is not mounted					#
# (1,type,options) - file system is currently mounted.			#
#########################################################################

sub is_mounted {
my $mntpnt=shift;
my $host=shift;
my $remote=0;
my ($fd,$cline,@lines);

	$host=hostname if !defined($host);
	@lines=();
	$remote=1 if $host ne hostname;
	if(!$remote) {
		open($fd,"/proc/mounts") or return(-1);
		@lines=<$fd>;
		close($fd);
	} else {
		$cline=`ssh $host -o batchmode=yes "cat /proc/mounts 2>/dev/null"`;
		chomp $cline;
		return(-1) if $cline eq "";
		@lines=split(/\n/m,$cline);
	}

	for (@lines) {
		my @f=split(/\s+/,$_);
		if($f[1] eq $mntpnt) {
			return(1,$f[2],$f[3]);
		}
	}
	return(0);
}

sub get_over_mounts($) {
my $mntpnt=shift;
my $fd;
my @R=();

	open($fd,"/proc/mounts") or return(undef);
	my @lines=<$fd>;
	close($fd);
	for (@lines) {
		my @f=split;
		if(length($f[1])>length($mntpnt) &&
			substr($f[1],0,length($mntpnt)+1) eq "$mntpnt/") {
			push @R,$f[1];
		}
	}
	return @R;
}

sub get_device_info {
my $mntpnt=shift;
my ($fd,$cline,@F,@F2);

	open($fd,"/proc/mounts") or return(undef,undef);
	while(<$fd>) {
		chomp;
		@F=split;
		next if $F[1] ne $mntpnt;
		close($fd);

		#########################################################
		# Dev can be /dev/VG/LV - even if the bdf/mount		#
		# output is showing the devmapper device info.		#
		#########################################################

		@F2=split(/\//,$F[0]);
		if(scalar(@F2)!=4) {
			return(undef,undef);
		}
		return($F2[2],$F2[3]);
	}
	close($fd);
	return(undef,undef);
}

#########################################################################
# This routine will return a list consisting of the kernel modules	#
# loaded on the specified machine.					#
# Arguement specified is the hostname to check.				#
#########################################################################

sub get_kernel_mods {
my $host=shift;
my @l=();
my @lines;
my $fd;
my $r;

	if($host eq hostname) {
		if(!open($fd,"/proc/modules")) {
			errmsg("Unable to open /proc/modules on $host",61);
		}
		@lines=<$fd>;
		close($fd);
	} else {
		$r=`ssh $host -o batchmode=yes cat /proc/modules 2>/dev/null`;
		if($?>>8) {
			errmsg("Unable to open /proc/modules on $host",61);
		}
		@lines=split(/\n/,$r);
	}

	foreach (@lines) {
		my @x;

		@x=split(/\s+/,$_);
		push @l,$x[0];
	}
	return @l;
}

#########################################################################
# Will load (if required) the drbd modules on the local machine,	#
# and will return if OK, exit with message if error.			#
# The parameter taken is drbd or drbd - which indicates the requried	#
# modules to load.							#
#########################################################################

sub local_drbd_module_check_n_load {
my $datadetail=$_[0];
my $maxdevs=64;
if(exists($_[1])) {
	$maxdevs=$_[1];
}
my ($nbd_kernel,$nbd_module,$drbd_module)=(0,0,0);
my (@lkernel,$kernel,$lnode);

	$lnode=hostname;
	@lkernel=get_kernel_mods($lnode);
	#########################################################
	# DRBD is always a module, so simply check mods.	#
	#########################################################

	if(scalar(grep {/^drbd$/ } @lkernel)) {
		if(-f "/proc/drbd") {
			$drbd_module=1;
		}
	}
	if($drbd_module) {
		logmsg("drbd kernel module loaded already on $lnode");
		return;
	}

	#########################################################
	# 0186:	We check to see if the module is defined for	#
	#	the running kernel and abort if not.		#
	#########################################################

	my $u;
	$u=`uname -r`; chomp $u;
	if(! -f "/lib/modules/$u/kernel/drivers/block/drbd.ko" &&
	   ! -f "/lib/modules/$u/updates/drbd.ko" &&
	   ! -f "/lib/modules/$u/kernel/drivers/block/drbd/drbd.ko" &&
	   ! -f "/lib/modules/$u/kernel/drivers/block/drbd.o") {
		errmsg("There does not appear to be a working drbd kernel module");
		errmsg("available for the currently running kernel: $u");
		errmsg("You may just have to do the following (depending on distribution):");
		errmsg("# cd /usr/src/cluster/drbd-x.y.z");
		errmsg("# make clean ; cd tools; make ; make install;");
		errmsg("# cd ../drbd; make; make install",99);
	}
	logmsg("Loading DRBD kernel module locally.");
	$r=`/sbin/modprobe drbd minor_count=$maxdevs 2>&1`;
	if($?>>8!=0) {
		errmsg("Unable to load drbd module:\n$r",60);
	}
	# Wait up to 5 seconds for main /proc/ fs to appear
	my $cc=0;
	while($cc<25) {
		last if -e "/proc/drbd";
		select(undef,undef,undef,0.2);
		$cc++;
	}
}

sub remote_drbd_module_check_n_load($$) {
my $rnode=shift;
my $xml=shift;
my $datadetail=$xml->{global}->{datadetail};
my $maxdevs=64;
if(exists($xml->{global}->{maxblockdevs})) {
	$maxdevs=$xml->{global}->{maxblockdevs};
}
my ($nbd_kernel,$nbd_module,$drbd_module)=(0,0,0);
my (@rkernel,$kernel,$lnode);

	@rkernel=get_kernel_mods($rnode);
	#########################################################
	# DRBD is always a module, so simply check mods.	#
	#########################################################
	if(scalar(grep {/^drbd$/} @rkernel)) {
		if(-f "/proc/drbd") {
			$drbd_module=1;
		}
	}
	if($drbd_module) {
		logmsg("drbd kernel module loaded already on $rnode");
		return;
	}
	#################################################################
	# 0186:	Check to see if a module exists for the running kernel	#
	#	and if not issue an error message.			#
	#################################################################
	my ($u,$u2);
	$u=ssh_on_node(node=>$rnode,xml=>$xml,cmd=>"uname -r"); chomp $u;
	$u2=ssh_on_node(node=>$rnode,xml=>$xml,cmd=>"ls /lib/modules/$u/kernel/drivers/block/drbd/drbd.ko /lib/modules/$u/updates/drbd.ko /lib/modules/$u/kernel/drivers/block/drbd.ko /lib/modules/$u/kernel/drivers/block/drbd.o 2>/dev/null");
	chomp $u; chomp $u2;
	if($u2 eq "") {
		errmsg("There does not appear to be a working drbd kernel module");
		errmsg("available for the currently running kernel on ");
		errmsg("node $rnode: $u");
		errmsg("You may just have to do the following on $rnode");
		errmsg("(depending on distribution):");
		errmsg("# cd /usr/src/cluster/drbd-x.y.z");
		errmsg("# make clean ; cd tools; make ; make install;");
		errmsg("# cd ../drbd; make; make install",99);
	}

	if($drbd_module==0) {
		logmsg("Loading DRBD kernel module on remote host.");
		$r=ssh_on_node(node=>$rnode,xml=>$xml,cmd=>"/sbin/modprobe drbd minor_count=$maxdevs 2>&1");
		if($?>>8!=0) {
			errmsg("Unable to load drbd module:\n$r",60);
		}
	}
	# Wait up to 5 seconds for devices to appear
	my $cc=0;
	while($cc<5) {
		my $r=ssh_on_node(node=>$rnode,xml=>$xml,cmd=>"ls /proc/drbd 2>/dev/null");
		chomp $r;
		last if length($r);
		select(undef,undef,undef,1);
		$cc++;
	}
}

sub mapdevicename {
my ($x,$y);
my $devnum=$_[0];

	if($devnum<26) {
		$x=chr(ord('a')+$devnum);
		return $x;
	}
	$x=chr(ord('a')+int($devnum/26));
	$y=chr(ord('a')+$devnum%26);
	return "$x$y";
}

#########################################################################
# Returns reference to hash if the specified drbd device exists,	#
# otherwise undef. If returns the following fieds;			#
# cs (Connection State): Unconfigured, Standalone, Connected,		#
# SyncSource,SyncTarget, PausedSync (lower case)			#
# st (Local/Remote): Primary|Secondary|Unknown/Primary|Secondary|Unknown#
# ld (Local data consistancy): consistent, unconsistent			#
#    [=>..................] sync'ed:  7.7% (101512/102400)K		#
#        finish: 0:33:50 speed: 4 (4) K/sec				#
#########################################################################

sub get_drbd_dev_status {
my $devnum=$_[0];
my ($fd,@f,@f2,@f3,@f4,$cd,$cline);
my $info={};
my $drbd_version;

	@f=();
	@f2=();
	@f3=();
	@f4=();
	open($fd,"/proc/drbd") or return(undef);
	$_=<$fd>; @f=split; $drbd_version=$f[1]; @f=(); <$fd>; # Ignore first two lines - but get version!
	while(<$fd>) {
		chomp;
		if(/^\s*([0-9]+):\s+/) {
			$cd=$1;
			s/^\s+//;
			@f=split(/\s+/,$_);
			if($cd != $devnum) {
				if($f[1] eq "cs:Unconfigured") {
					next;
				}
				<$fd>;
				next;
			}
			if($f[1] ne "cs:Unconfigured") {
				@f2=(); @f3=(); @f4=();
				$cline=<$fd>; last if !defined($cline);
				$cline =~ s/^\s+//; last if !defined($cline);
				@f2=split(/\s+/,$cline);
				$cline=<$fd>; last if !defined($cline);
				$cline =~ s/^\s+//;
				if($cline =~ /\[/) {
					$cline =~ s/\s+delay_probe:.*//;
					@f3=split(/\s+/,$cline);
					$cline=<$fd>;
					$cline =~ s/^\s+//;
					@f4=split(/\s+/,$cline);
				}
			}
			last;
		}
	}
	close($fd);
	if(scalar(@f2)) {
		foreach (@f,@f2) {
			next if ! /([a-z]+):(.*)/;
			$info->{$1}=lc($2);
		}
		if(scalar(@f3)) {
			my ($x,$b1,$b2);
			my $multi=1;
			$x=$f3[$#f3];
			if($x =~ /\)M$/) {
				$multi=1024;
			}
			$x =~ s/\(//;
			$x =~ s/\)[MK]//;
			($b1,$b2)=split(/\//,$x);
			if($drbd_version =~ /^8\./) {
				$info->{total}=$b2*$multi;
				$info->{bad}=$b1*$multi;
				$info->{good}=$info->{total}-$info->{bad};
			} else {
				$info->{total}=$b2*$multi;
				$info->{good}=$b1*$multi;
				$info->{bad}=$info->{total}-$info->{good};
			}
		}
		if(scalar(@f4)) {
			my ($hours,$mins,$secs);
			
			($hours,$mins,$secs)=split(/:/,$f4[1]);
			$info->{est}=sprintf("%.1f",($hours*60+$mins)+($secs/60));
			$f4[3] =~ s/,//g;
			$info->{speed}=$f4[3];
		}
		#################################################################
		# For drbd v8 we use {ds} rather than {ld} so convert...	#
		#################################################################
		if(!exists($info->{ld}) && exists($info->{ds})) {
			if($info->{ds} =~ /^uptodate/) {
				$info->{ld}="consistent";
			} else {
				$info->{ld}="inconsistent";
			}
		}
		return $info;
	}
	return undef;
}

sub summary_sync_state {
my $ref=$_[0];
my ($cs,$st,$ld);

	$cs=$ref->{cs};
	$st=$ref->{st} if exists($ref->{st});
	$ld=$ref->{ld} if exists($ref->{ld});
	$st=$ref->{ro} if exists($ref->{ro});

	if(!defined($st) || !defined($ld)) {
		return "unknown";
	}
	return "sync" if $cs eq "connected";
	if(scalar(grep {/^$cs$/} qw(syncsource synctarget pausedsynct pausedsyncs))) {
		return "syncing";
	}
	if($cs eq "uptodate/uptodate") {
		return "sync";
	}
	return "unsync";
}

sub summary_valid_data {
my $ref=$_[0];
my ($x,$l,$r);

	if(!exists($ref->{ld})) {
		return "unknown";
	}
	if($ref->{ld} eq "consistent" && $ref->{cs} eq "connected") {
		return "both";
	}
	if($ref->{ld} eq "consistent") {
		return "local";
	}
	$x=$ref->{cs};
	#################################################################
	# Check to see if a sync is occuring, since this defines	#
	# were the valid data source is.				#
	#################################################################
	if($x eq "syncsource" || $x eq "pausedsyncs") {
		return "local";
	}
	if($x eq "synctarget" || $x eq "pausedsynct") {
		return "remote";
	}

	return "none!";
}

sub summary_connection_state {
my $ref=$_[0];
my ($st,$cs);

	if(exists($ref->{st})) {
		$st=$ref->{st};
	} else {
		$st=$ref->{ro};
	}
	$cs=$ref->{cs};
	if($st =~ /primary/ && $cs =~ /wfconnection|syncsource|synctarget|connected/) {
		return "active";
	}
	if($cs =~ /standalone/) {
		return "standalone";
	}
	return "inactive";
}

#########################################################################
# Uses the get_node_ssh_ip to ssh to the specified node and returns	#
# the output as a string, undef/empty if error.				#
# node,xml,cmd,[timeout]						#
#########################################################################

sub ssh_on_node {
my %args=@_;

	$args{timeout}=2 if !exists($args{timeout});
	my ($ip,$comment)=get_node_ssh_ip(%args);
	if(!defined($ip)) {
		return undef;
	}
	my $r=`ssh $ip -o batchmode=yes "$args{cmd}"`;
	return $r;
}

#########################################################################
# lfile,rfile,node,xml as args - exit_val as return code.		#
#########################################################################

sub scp_to_node {
my %args=@_;

	my ($ip,$comment)=get_node_ssh_ip(%args);
	if(!defined($ip)) {
		return 1; # Failed to copy
	}
	if($ip =~ /:/ && substr($ip,0,1) ne '[') {
		$ip="[$ip]";
	}
	`scp $args{lfile} $ip:$args{rfile} 2>/dev/null`;
	my $e=$?>>8;
	return $e;
}

#########################################################################
# Return the IP address to use to ssh to a given node. Takes the	#
# the following arguments;						#
# node => name, timeout => seconds, xml => xmlref			#
# Timeout defaults to 2, and node defaults to the other node in the	#
# cluster.								#
# Returns (undef,errmsg) or (ip,comment)				#
# The comment will be either of the following;				#
# Using primary nodename						#
# Using Heartbeat IP address X.X.X.X					#
# Using NBD IP address X.X.X.X						#
#########################################################################

{
my $last_node_ip;

sub get_node_ssh_ip {
my %args=@_;
my (@ips,$node,$rip,$n,$cip,$r,$timeout,@nodes,$xml);
my @F;

	if(!defined($last_node_ip)) {
		$last_node_ip={};
	}

	if(!exists($args{xml})) {
		return(undef,"Missing mandatory xml argument.");
	}
	$xml=$args{xml};
	confess("Undefined xml parameter value.") if(!defined($xml));
	$timeout=$args{timeout} if exists($args{timeout}) && defined($args{timeout});
	$timeout=2 if !defined($timeout);
	@nodes=sort(keys(%{$xml->{node}}));
	if(exists($args{node})) {
		$node=$args{node};
		confess("Node value undefined!") if(!defined($node));
		if($node ne $nodes[0] && $node ne $nodes[1]) {
			return(undef,"Unknown node $node");
		}
	} else {
		if($nodes[0] eq hostname) {
			$node=$nodes[1];
		} else {
			$node=$nodes[0];
		}
	}

	#########################################################
	# Now we need to test the hostname, and then 		#
	# IP addresses given for heartbeat, and then lastly	#
	# for NBD communication as a last resort.		#
	#########################################################

	@ips=CLNET_return_static_ips2(node=>$node);
	my $details=$xml->{node}->{$node}->{heartbeat};
	my $lip;

	#########################################################
	# If the last successful IP is available from static	#
	# variable then use it now.				#
	#########################################################

	if(exists($last_node_ip->{$node})) {
		$lip=$last_node_ip->{$node};
		@ips=($lip,@ips);
	} else {
		if($write_ssh_ip_info==0 && -f "/etc/cluster/.status/lastip.$node") {
			my ($fd,$cline);
			if(open($fd,"/etc/cluster/.status/lastip.$node")) {
				$lip=<$fd>; chomp $lip;
				if($lip =~ /^[0-9\.]+$/) {
					@ips=($lip,@ips);
				}
			}
		}
	}

	#################################################################
	#  For each IP address attempt to contact node.			#
	#################################################################
	$n=0;
	for $cip (@ips) {
		if($n && defined($lip) && $cip eq $lip) {
			next;	# Don't try lip twice
		}
		eval {
			local $SIG{ALRM}=sub { die "TIMEOUT" };
			alarm($timeout);
			$r=`ssh $cip -o batchmode=yes echo hello 2>/dev/null`;
			alarm(0);
		};
		
		if(!defined($r) || ($@ && $@ =~ /TIMEOUT/)) {
			$n++;
			next;
		}
		if($r !~ /hello/m) { 
			$n++;
			next;
		}
		$rip=$cip; last;
	}
	if(!defined($rip)) {
		return(undef,"No SSH communication possible with host.");
	}
	#################################################################
	# Improvement 0251:						#
	# Only the cluster daemon on a node should write out the	#
	# ip address to use, which can then be picked up by clients.	#
	#################################################################

	if($write_ssh_ip_info) {
		my ($fd,$cline);
		if(open($fd,">/etc/cluster/.status/lastip.$node")) {
			print $fd "$rip\n";
			close($fd);
		}
	}
	$last_node_ip->{$node}=$rip;
	@F=CLNET_map_ip_to_network2(ip=>$rip);
	$F[0]="!ERROR!" if !defined($F[0]);
	return($rip,"\"$F[0]\" network");
}
}

#########################################################################
# returns a list of networks that the specified application has		#
# connections to - or empty list if no, or error.			#
#########################################################################

sub netlist {
my $app=$_[0];
my ($xml2,$ty,$listref,$chashref,@l);

	@l=();
	eval {$xml2=XMLin("/etc/cluster/$app/appconf.xml");};
	return () if $@;
	return () if !defined($xml2);

	if(!exists($xml2->{networks})) {
		return ();
	}
	if(!exists($xml2->{networks}->{network})) {
		return ();
	} else {
		$ty=ref($xml2->{networks}->{network});
		if($ty eq "HASH") {
			$listref=[$xml2->{networks}->{network}];
		} else {
			$listref=$xml2->{networks}->{network};
		}
	}
	for $chashref (@$listref) {
		next if !exists($chashref->{net});
		push @l,$chashref->{net};
	}
	return @l;
}

sub match_node_name($$) {
my ($cnode,$xml)=@_;
my ($x,@nodes,$y);

	@nodes=sort(keys(%{$xml->{node}}));
	
	for (@nodes) {
		$x=$_;
		$y=$x;
		return $cnode if $cnode eq $x;
		$x=~ s/\.*//;
		return $y if $cnode eq $x;
	}
	return undef;
}

sub get_installed_drbdsetup_version {
	if(-x "/sbin/drbdadm") {
		$r=`/sbin/drbdadm help 2>&1`;
		($x) = ($r =~ /^Version:\s+(\d+\.\d+\.\d+)\s+/m);
		return $x if $x;
	}
	my $rmmod=0;
	if(! -f "proc/drbd") {
		$r=`/sbin/modprobe drbd`;
		$rmmod=1;
	}
	my $v=get_drbd_proc_version();
	if($rmmod) {
		$r=`/sbin/rmmod drbd`;
	}
	return $v;
}

sub get_drbd_proc_version {
	return undef if ! -f "/proc/drbd";
	my $fd;
	open($fd,"/proc/drbd") or return(undef);
	my $l=<$fd>;
	my ($x) = ($l =~ /^Version:\s+(\d+\.\d+\.\d+)\s+/i);
	close($fd);
	return $x;
}

sub compat_meta_version($$) {
my ($lv,$meta_lv)=@_;
my $v=get_drbd_proc_version();

	return(-1) if ! -x "/sbin/drbdmeta";
	my $cmd;
	if($v =~ /^8\./) {
		$cmd="/sbin/drbdmeta $lv v08 $meta_lv 0 get-gi";
	} else {
		$cmd="/sbin/drbdmeta $lv v07 $meta_lv 0 get-gi";
	}
	my $r=`$cmd 2>&1`;
	chomp $r;
	if($r =~ /is configured/) {
		return 1;
	}
	if(!defined($r) || $r eq "") {
		return(0);
	}
	return 1;
}

sub check_net_known_connections($) {
my $xml=shift;

	if(!exists($xml->{net_known_connections})) {
		::logwarn("No net_known_connections: Network partitioning support");
		::logwarn("will not function.");
		return(1);
	}
	my @ips=();
	if(!ref($xml->{net_known_connections})) {
		my @i=split(/\s+/,$xml->{net_known_connections});
		foreach (@i) {
			push @ips,$_ if length($_);
		}
	} else {
		my @i=split(/\s+/,$xml->{net_known_connections}->[0]);
		foreach (@i) {
			push @ips,$_ if length($_);
		}
	}
	if(!scalar(@ips)) {
		::logwarn("No IP addresses configured - Network partitioning");
		::logwarn("support will not function.");
		return(1);
	}
	my $pinger=Net::Ping->new("icmp",1);
	my $count=0;
	my $failed=0;
	my $threshold=50;

	for (@ips) {
		$count++;
		if(!$pinger->ping($_)) {
			$failed++;
		}
	}
	logmsg("Net Known Connections: $count [failed=$failed]");
	if($failed/$count*100 > $threshold) {
		::logwarn("Net Known Connections threshold passed - are addresses valid?");
		return 2;
	}
	return 0;
}

sub get_digest_methods($) {
my $node=shift;
my ($cmd,$res);

	$remote=1 if $node ne hostname;
	if(! $remote) {
		$cmd="cat /proc/crypto";
	} else {
		$cmd="ssh $node -o batchmode=yes 'cat /proc/crypto'";
	}
	$res=`$cmd 2>/dev/null`; chomp($res);
	my @R=split(/\n/,$res);

	my @digests=();
	my $cname="";
	for (@R) {
		my @F=split;
		next if ! @F;
		if($F[0] eq "name") {
			$cname=$F[2];
		}
		if($F[0] eq "type" && ($F[2] eq "digest" || $F[2] eq 'shash') ) {
			push @digests,$cname;
		}
	}
	return @digests;
}

1;
